home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / How_to_Cap2198512222011.psc / Player Capture Frame / CommonDialog.cls next >
Text File  |  2009-10-08  |  5KB  |  165 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "CommonDialog"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OpenFilename) As Long
  17. Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OpenFilename) As Long
  18. Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
  19. Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
  20. Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
  21.  
  22. Private Type OpenFilename
  23.     lStructSize As Long
  24.     hWndOwner As Long
  25.     hInstance As Long
  26.     lpstrFilter As String
  27.     lpstrCustomFilter As String
  28.     nMaxCustFilter As Long
  29.     nFilterIndex As Long
  30.     lpstrFile As String
  31.     nMaxFile As Long
  32.     lpstrFileTitle As String
  33.     nMaxFileTitle As Long
  34.     lpstrInitialDir As String
  35.     lpstrTitle As String
  36.     flags As Long
  37.     nFileOffset As Integer
  38.     nFileExtension As Integer
  39.     lpstrDefExt As String
  40.     lCustData As Long
  41.     lpfnHook As Long
  42.     lpTemplateName As String
  43. End Type
  44.  
  45. Private Type BrowseInfo
  46.     hWndOwner As Long
  47.     pIDLRoot As Long
  48.     pszDisplayName As Long
  49.     lpszTitle As Long
  50.     ulFlags As Long
  51.     lpfnCallback As Long
  52.     lParam As Long
  53.     iImage As Long
  54. End Type
  55.  
  56. Private Const BIF_RETURNONLYFSDIRS = 1
  57. Private Const BIF_DONTGOBELOWDOMAIN = 2
  58. Private Const MAX_PATH = 260
  59.  
  60. Private Const OFN_OVERWRITEPROMPT = &H2
  61. Private OFN As OpenFilename
  62. Private myBrowseInfo As BrowseInfo
  63.  
  64. Public Property Let FileName(ByVal sFileName As String)
  65. OFN.lpstrFile = sFileName & Chr(0)
  66. End Property
  67. Public Property Get FileName() As String
  68. FileName = Replace(OFN.lpstrFile, Chr(0), "")
  69. OFN.lpstrFile = String$(1024, 0)
  70. End Property
  71.  
  72. Public Property Let filter(ByVal sFilter As String)
  73. sFilter = Replace(sFilter, "|", Chr(0))
  74. OFN.lpstrFilter = sFilter & Chr(0) & Chr(0)
  75. End Property
  76. Public Property Get filter() As String
  77. Dim temp As String
  78. temp = OFN.lpstrFilter
  79. While Right(temp, 1) = Chr(0)
  80.     temp = Mid(temp, 1, Len(temp) - 1)
  81. Wend
  82. temp = Replace(temp, Chr(0), "|")
  83. filter = temp
  84. End Property
  85.  
  86. Public Property Let FileTitle(ByVal sFileTitle As String)
  87. OFN.lpstrFileTitle = sFileTitle
  88. End Property
  89.  
  90. Public Property Get FileTitle() As String
  91. FileTitle = OFN.lpstrFileTitle
  92. End Property
  93.  
  94. Public Property Let DialogTitle(ByVal sDialogTitle As String)
  95. OFN.lpstrTitle = sDialogTitle
  96. End Property
  97. Public Property Get DialogTitle() As String
  98. DialogTitle = Replace(OFN.lpstrTitle, Chr(0), "")
  99. End Property
  100.  
  101. Public Property Let InitDir(ByVal sInitDir As String)
  102. OFN.lpstrInitialDir = sInitDir & Chr(0)
  103. End Property
  104. Public Property Get InitDir() As String
  105. InitDir = Replace(OFN.lpstrInitialDir, Chr(0), "")
  106. End Property
  107.  
  108. Public Property Let DefaultExt(ByVal sDefaultExt As String)
  109. sDefaultExt = Replace(sDefaultExt, ".", "")
  110. OFN.lpstrDefExt = sDefaultExt
  111. End Property
  112. Public Property Get DefaultExt() As String
  113. DefaultExt = OFN.lpstrDefExt
  114. End Property
  115.  
  116. Public Sub ShowOpen()
  117. Dim ret As Long
  118. OFN.nFilterIndex = 1
  119. ret = GetOpenFileName(OFN)
  120. End Sub
  121.  
  122. Public Sub ShowSave()
  123. Dim ret As Long
  124. OFN.nFilterIndex = 1
  125. ret = GetSaveFileName(OFN)
  126. End Sub
  127.  
  128. Public Function GetFolderName(DialogTitle As String) As String
  129. Dim lpIDList As Long
  130. Dim RetStr As String
  131. Dim myBrowseInfo As BrowseInfo
  132.  
  133. With myBrowseInfo
  134.     .hWndOwner = 0
  135.     .lpszTitle = lstrcat(DialogTitle, "")
  136.     .ulFlags = BIF_RETURNONLYFSDIRS Or BIF_DONTGOBELOWDOMAIN
  137. End With
  138.  
  139. lpIDList = SHBrowseForFolder(myBrowseInfo)
  140.  
  141. If lpIDList Then
  142.     RetStr = String$(MAX_PATH, 0)
  143.     SHGetPathFromIDList lpIDList, RetStr
  144.     RetStr = Left$(RetStr, InStr(RetStr, vbNullChar) - 1)
  145. End If
  146.  
  147. GetFolderName = RetStr
  148. End Function
  149.  
  150. Private Sub Class_Initialize()
  151. With OFN
  152.     .lStructSize = Len(OFN)
  153.     .flags = OFN_OVERWRITEPROMPT
  154.     .lpstrFile = String$(1024, 0)
  155.     .nMaxFile = 1024
  156.     .lpstrFileTitle = String$(256, 0)
  157.     .nMaxFileTitle = 256
  158.     .lpstrDefExt = "txt"
  159. End With
  160. End Sub
  161.  
  162.  
  163.  
  164.  
  165.